Proyecto - Contingencias de Vida II
Librerías e importaciones
Factor de degradación para estados CAR
La metodología original empezaba a dar problemas con probabilidades negativas a partir de una edad aproximada de 95 años, por lo que se decidió implementar un factor de reducción desde los 90 años para primero, complementar la probabilidad creciente de muerte y además poder arreglar el problema de probabilidades negativas.
Mejora de mortalidades en el tiempo y mejora de transiciones de empeoramiento
Comprobación de mejoras
## Able Mild Moderate Severe Profound Dead
## [1,] 47.37206 6.189601 3.146575 2.593122 3.690927 37.00772
edad20sin_m <- lapply(Males, function(x) as.data.frame(x[21:120,]))
calculo_acumulado(20, edad20sin_m)## Able Mild Moderate Severe Profound Dead
## [1,] 42.42812 5.499605 2.619834 1.856993 2.063667 45.53178
Hay una clara diferencia entre mejorías de mortalidades
Cálculo de valores presentes
Se puede realizar varios seguros con los resultados de calculo_vp. Nótese que estamos en edad 20
prueba <- calculo_vp(20, edad20, 0.07, 0.03)
# Seguro de vida normal, 100 millones
(prueba[6]*100e6 )/(12*prueba[1])## [1] 40566.67
# Seguro de vida con anualidades en caso de Severe o Profound, pagando Mild y Moderate
(prueba[6]*100e6 + 12*(1.5e6*prueba[4] + 3e6*prueba[5]))/(12*(prueba[1]+prueba[2]+prueba[3]))## [1] 131244.9
# Seguro de vida con anualidades pagando 0.25e6 en aumento de estado
(prueba[6]*100e6 + 12*(0.25e6*prueba[2] +
0.5e6*prueba[3] +
0.75e6*prueba[4] +
1e6*prueba[5]))/(12*prueba[1])## [1] 111971.3
# Seguro de vida con anualidades pagando 0.5e6 en aumento de estado
(prueba[6]*100e6 + 12*(0.5e6*prueba[2] +
1e6*prueba[3] +
1.5e6*prueba[4] +
2e6*prueba[5]))/(12*prueba[1])## [1] 183375.8
Cálculo de las primas
Portafolio
Generación del portafolio
Se utiliza una normal para centrar las observaciones en una edad de interés
set.seed(70707)
portfolio <- data.frame(edad = round(rnorm(5000, mean = 45, sd = 6.5)),
sexo = round(runif(5000, 1, 2))) %>%
arrange(., edad, sexo) %>%
mutate(id = dense_rank(paste(edad, sexo)))
descripcion <- portfolio %>% count(edad, sexo)Y se genera la lista de probabilidades
Modelo estocástico
Proyección de primas
Esto es extra, no se piden.
t <- proc.time()
proy_prima_data <- proy_prima_par(1000, 0.07, 0.03)
raw <- proy_prima_data
proc.time()-t## user system elapsed
## 0.04 0.14 34.21
Calculamos la prima estocástica al percentil 99.5
proy_prima_data <- list()
for(i in 1:100){
proy_prima_data[[i]] <- raw[,,i]
}
proy_prima_data <- sapply(proy_prima_data, function(x) prima(descripcion$n %*% x))
quantile(proy_prima_data, 0.005)## 0.5%
## 96788.19
Preparación para modelar estocásticamente
Variables globales
interes <- 0.07
inflacion <- 0.03
edades <- portfolio$edad
rango <- 120 - min(edades)
v <- (1 + inflacion) / (1 + interes)
v_power <- v^(0:rango)
mujeres <- sum(portfolio$sexo == 2)
hombres <- sum(portfolio$sexo == 1)
sexos <- portfolio$sexo == 1
variables <- c("lista",
"portfolio",
"sexos",
"hombres",
"mujeres",
"rango",
"v_power",
"proyeccion") Resumen estocástico
Esperanza
Guardar las proyecciones
Leer las proyecciones
media <- list(
read_xlsx("res/media.xlsx", sheet = 1),
read_xlsx("res/media.xlsx", sheet = 2),
read_xlsx("res/media.xlsx", sheet = 3),
read_xlsx("res/media.xlsx", sheet = 4)
)
percent.995 <- list(
read_xlsx("res/percentil.xlsx", sheet = 1),
read_xlsx("res/percentil.xlsx", sheet = 2),
read_xlsx("res/percentil.xlsx", sheet = 3),
read_xlsx("res/percentil.xlsx", sheet = 4)
)Gráficos
Ingresos y egresos
## [1] 10846416988
## [1] 10364507602
## [1] 10838876838
## [1] 10530397885
## [1] 11059119801
## [1] 9262965590
## [1] 11059395809
## [1] 9459461593